home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / chrchpr2.arc / CSURVEY.CMD < prev    next >
Encoding:
Text File  |  1979-12-31  |  6.5 KB  |  218 lines
  1. * Program CSURVEY - Controls all CHURCH SURVEY program operations
  2. Clear
  3. Set talk off
  4. Set bell off
  5. Set deleted on
  6. Set intensity off
  7. Set exact off
  8. Store 'January  February March    April    May      June     ' to MONTHS
  9. Store MONTHS+'July     August   SeptemberOctober  November December ' to MONTHS
  10. If $(DATE(),7,2) = '00'
  11.   Set date to 01,01,00
  12. ENDIF
  13.   Store ' ' to curmonthx
  14.   Store ' ' to curyear
  15.   Store ' ' to curmonth
  16.   * Set today's date from current system-date
  17.   Store $(date(),1,2) to curmo
  18.   Store $(date(),7,2) to curmonthx
  19.   Store val(curmo) to nmonth
  20.   Store curmo+curmonthx to indate
  21.   Store VAL(curmonthx) to CURYEAR
  22.   If $(date(),4,1) = '0'
  23.     Store $(DATE(),5,1) to CURMONTHX
  24.   else
  25.     Store $(DATE(),4,2) to CURMONTHX
  26.   endif
  27.   Store trim($(months,NMONTH*9-8,9)) to curmonth
  28.   Store curmonth+' '+curmonthx to curmonthx
  29.   Store ', 19'+$(DATE(),7,2) to CURYEAR
  30.   Store curmonthx+curyear to curdate
  31. Select primary
  32. USE CSURVEY
  33. Store trim($(QU1,1,27)) to chname
  34. GOTO 2
  35. Store !($(QU1,12,1)) to D
  36. USE
  37. release curmo,months,curyear,curmonthx,nmonth
  38. Store d+':MEMBERSS' to MFILE
  39. Store T to LEVEL2
  40. Do while LEVEL2
  41.   Save to UMEMVARS
  42.   Select primary
  43.   Erase
  44.   @ 2,1 say 'DATA DISK = '+D
  45.   @ 2,61 say curdate
  46.   @ 3,20 SAY '        C S U R V E Y                      6-/CSURVEY/'
  47.   @ 5,13 say ' Processes Survey Data and Makes Summary Reports'
  48.   @ 7,9 say  ' 1)  Clear the MEMBERSS file and re-index'
  49.   @ 8,9 say  ' 2)  Enter Survey Questions, Possible Answers         /CSQUESTS/'
  50.   @ 9,9 say  ' 3)  Print the Survey form                            /CSQUESTS/'
  51.   @ 10,9 SAY ' 4)  Enter Individual Member Answers                  /CSANSWRS/'
  52.   @ 11,9 say ' 5)  Display/Print Summary Report    '
  53.   @ 12,9 say ' 6)  Set up - Names Directory Editing'
  54. ?
  55. Accept '          Enter selection' to MSEL
  56. ?
  57. If !(MSEL)='DISK='
  58.   Store !($(msel,6,1)) to D
  59.   ? 'Disk now being set to drive ',D
  60.   Save to UMEMVARS
  61. else
  62. Store F to validd1
  63. Do while .NOT. validd1
  64.   Store T to validd1
  65.   Do CASE
  66.     CASE MSEL = '1'
  67. ? 'This routine operates on the MEMBERSS file, which is from the MPROFILE'
  68. ?? 'program'
  69. ? 'The operator needs to make a copy of the main MEMBERS file, with the'
  70. ?? 'alternate'
  71. ? 'name, MEMBERSS, and have that disk as the data disk. Or you may want to'
  72. ?? 'select'
  73. ? 'a certain group of MEMBERS for this survey.  You would perform the "Special'
  74. ? 'Files, Create a new file" process from MPROFILE, then name the new file'
  75. ?? 'MEMBERSS.'
  76. ? 'The MEMBERS.NDX file is not needed.  This Survey process just needs a file'
  77. ? 'called MEMBERSS that has most of the same data fields as the MEMBERS file.'
  78. Accept '   -  -  -  -  -  -  O K   T O   G O   A H E A D ?    '  to XX
  79.      If !(XX)='Y'
  80.       STORE D+':MEMBERSS' to MFILE
  81.       If .not. file(MFILE)
  82.         Accept 'MEMBERSS file not found on the data disk. Press <retn>' to XX
  83.       else
  84.        Use &MFILE
  85. Accept 'Now about to clear the answer field of each MEMBERSS record. OK?' to XX
  86.        If !(XX)='Y'
  87.        ? 'Now clearing the answers field of the MEMBERSS file for each member.'
  88.        Set talk on
  89.        Replace ALL ssscattd with ' '
  90.        ? 'Now indexing the MEMBERSS file.'
  91.        Index on last:name+first:name to &MFILE
  92.        Set talk off
  93.   Accept ;
  94.  'The MEMBERSS file has now been cleared for a new survey. Press <RETN>' to XX
  95.        endif
  96.        endif
  97.       endif
  98.     CASE MSEL = '2'
  99.       DO CSQUESTS.CMD
  100.       Release xx,ii,set,sett,done,valansw,cl,i,iii,es,inval2,answ
  101.    CASE MSEL = '3'
  102.       DO CSQUESTS.CMD
  103.       Release xx,ii,set,sett,done,valansw,cl,iii,i,es,inval2,answ
  104.     CASE MSEL = '4'
  105.       Do CSANSWRS.CMD
  106.       Release valansw,cscontin,invalcc,inhh,match,inln,infn,matchingl,matching,
  107.       Release pmatching,nxtmatch,xx,csurv1,csurv2,csurv3,set,ii,done,invala,xna
  108.       Release xname,tel,invalansw,i,cl,iii,nna,nnb,nnc,nnd,nne,nnf,nng,nnh,nni
  109.       Release nnj,nnk,nnl,nnm,nnn,nno,nnp,nnq,nnr,nns,nnt,es,inval2
  110.     CASE MSEL = '5'
  111.       Select secondary
  112.       Use CSURVEY
  113. GOTO 10
  114. ? '          ',chname,'  -  Survey Report    ',curdate
  115. ?
  116. ? '         ',QU1
  117. SKIP
  118. Select primary
  119. Use &MFILE
  120. ?
  121. ? '               Names being processed:'
  122. COUNT ALL to ME
  123. ?? ME
  124. ? '               Names with  responses:'
  125. use membssx
  126. Copy structure to MEMBSS
  127. Use MEMBSS
  128. Store d+':MEMBERSS' to xx
  129. Append from &XX for ;
  130.  SSSCATTD<>'                                                           '
  131. Use MEMBSS
  132. goto bottom
  133. Store # to MR
  134. ?? MR
  135. GOTO TOP
  136. Store 1 to NMAX
  137. Store 0 to NN
  138. Select secondary
  139. ? '___________________________________________________________________________'
  140. ?
  141. If MR=0
  142.   ? 'None of the names in the MEMBERSS file have responses.'
  143. else
  144. Do while CSANSWRSX<>'     '
  145.   Store NN+1 to NN
  146.   Store 0 to xc
  147.   Store len(trim(CSANSWRSX)) to xcmax
  148.   ? str(#-10,3),'. ',csanswrsx,QU1
  149.   Select primary
  150.   Replace ALL calling with $(ssscattd,NN,1)
  151.   Select secondary
  152.   Set raw off
  153.   Do while xc<xcmax
  154.     Store xc+1 to xc
  155.     Store str(xc,1) to CC
  156.     Store $(csanswrsx,xc,1) to namea
  157.     Select primary
  158.     COUNT ALL for calling = namea to answ
  159.     Select secondary
  160.     Set exact on
  161.     Store str(answ/MR*100,3) to answper
  162.     ? str(answ,7),answper,'%  ',an&CC
  163.     Set exact off
  164.   enddo
  165.   Set raw on
  166.   Select primary
  167.   COUNT ALL for calling =' ' to ANSW
  168.   Select secondary
  169.   Store str(answ/MR*100,2) to answper
  170.   ? '     ',ANSW,'  ',answper,' %   (no response) '
  171.   ?
  172.   SKIP
  173. enddo
  174. endif
  175. Release ME,MR,ANSW,ANSWPER,namea,cc,xc,xcmax,nn,nmax,qux,pag,cl,qun,i,twocolm
  176. Release im,anii,anim
  177. Accept 'Report is complete. Press <retn>' to xx
  178.     CASE MSEL = '6'
  179.       Select secondary
  180.       Use CSURVEY
  181.       Store $(QU1,1,27) to chname
  182.       GOTO 2
  183.       Store $(QU1,12,1) to D
  184.       @ 19,8 say '           NAMES DIRECTORY EDITING                          '
  185.       Set intensity off
  186.       @ 21,12 say 'church name ' get chname
  187.       @ 22,12 say 'data disk   ' get D
  188.       READ
  189.       Set intensity off
  190.       ? 'Now writing the parameters into the Names Directory file (CSURVEY).'
  191.       Replace QU1 with $(QU1,1,11)+D
  192.       GOTO 1
  193.       Replace QU1 with chname
  194.       Use
  195.       Save to FMEMVARS
  196.       Select primary
  197.     CASE !(MSEL) = 'Q'
  198.       Select secondary
  199.       USE
  200.       Select primary
  201.       USE
  202.       Store F to LEVEL2
  203.     OTHERWISE
  204.       Accept 'Illegal selection. Please enter again ' to MSEL
  205.       Store F to validd1
  206.   ENDCASE
  207.   ENDDO
  208. endif
  209. ENDDO
  210. Restore from UMEMVARS
  211. ENDDO
  212. Store T to LEVEL1
  213. Store T to validd1
  214. RETURN
  215. namea
  216.     Select primary
  217.     COUNT ALL for calling = namea to answ
  218.